home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / getdis1r / frmmail.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-07-26  |  8.5 KB  |  241 lines
  1. VERSION 5.00
  2. Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
  3. Begin VB.Form frmMain 
  4.    Caption         =   "<Your Program Name Here> Send E-Mail"
  5.    ClientHeight    =   6072
  6.    ClientLeft      =   60
  7.    ClientTop       =   348
  8.    ClientWidth     =   8088
  9.    Icon            =   "frmMail.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   6072
  14.    ScaleWidth      =   8088
  15.    StartUpPosition =   2  'CenterScreen
  16.    Begin VB.Frame Frame1 
  17.       Caption         =   "Status:"
  18.       Height          =   615
  19.       Left            =   720
  20.       TabIndex        =   15
  21.       Top             =   4800
  22.       Width           =   6612
  23.       Begin VB.Label StatusTxt 
  24.          Height          =   252
  25.          Left            =   120
  26.          TabIndex        =   16
  27.          Top             =   240
  28.          Width           =   6372
  29.       End
  30.    End
  31.    Begin VB.TextBox txtEmailServer 
  32.       Height          =   285
  33.       Left            =   4080
  34.       TabIndex        =   13
  35.       Top             =   1440
  36.       Width           =   3852
  37.    End
  38.    Begin VB.TextBox ToNametxt 
  39.       Height          =   285
  40.       Left            =   4080
  41.       TabIndex        =   11
  42.       Top             =   840
  43.       Width           =   3852
  44.    End
  45.    Begin VB.TextBox txtFromName 
  46.       Height          =   285
  47.       Left            =   4080
  48.       TabIndex        =   9
  49.       Top             =   240
  50.       Width           =   3852
  51.    End
  52.    Begin VB.CommandButton Command2 
  53.       Caption         =   "&Cancel"
  54.       Height          =   495
  55.       Left            =   5400
  56.       TabIndex        =   8
  57.       Top             =   5520
  58.       Width           =   1695
  59.    End
  60.    Begin VB.TextBox txtEmailBodyOfMessage 
  61.       Height          =   2772
  62.       Left            =   120
  63.       MultiLine       =   -1  'True
  64.       ScrollBars      =   2  'Vertical
  65.       TabIndex        =   7
  66.       Top             =   1920
  67.       Width           =   7812
  68.    End
  69.    Begin VB.TextBox txtEmailSubject 
  70.       Height          =   285
  71.       Left            =   120
  72.       TabIndex        =   5
  73.       Top             =   1440
  74.       Width           =   3732
  75.    End
  76.    Begin VB.TextBox txtToEmailAddress 
  77.       Height          =   285
  78.       Left            =   120
  79.       TabIndex        =   3
  80.       Top             =   840
  81.       Width           =   3732
  82.    End
  83.    Begin VB.TextBox txtFromEmailAddress 
  84.       Height          =   285
  85.       Left            =   120
  86.       TabIndex        =   1
  87.       Top             =   240
  88.       Width           =   3732
  89.    End
  90.    Begin VB.CommandButton Command1 
  91.       Caption         =   "&Send E-Mail"
  92.       Height          =   495
  93.       Left            =   960
  94.       TabIndex        =   0
  95.       Top             =   5520
  96.       Width           =   2175
  97.    End
  98.    Begin MSWinsockLib.Winsock Winsock1 
  99.       Left            =   4080
  100.       Top             =   5520
  101.       _ExtentX        =   593
  102.       _ExtentY        =   593
  103.       _Version        =   393216
  104.    End
  105.    Begin VB.Label Label6 
  106.       Caption         =   "Your E-Mail Server Address:"
  107.       Height          =   252
  108.       Left            =   4080
  109.       TabIndex        =   14
  110.       Top             =   1200
  111.       Width           =   3372
  112.    End
  113.    Begin VB.Label Label5 
  114.       Caption         =   "Confirm Their E-Mail Address:"
  115.       Height          =   252
  116.       Left            =   4080
  117.       TabIndex        =   12
  118.       Top             =   600
  119.       Width           =   3372
  120.    End
  121.    Begin VB.Label Label4 
  122.       Caption         =   "Confirm Your E-Mail Address:"
  123.       Height          =   252
  124.       Left            =   4080
  125.       TabIndex        =   10
  126.       Top             =   0
  127.       Width           =   3132
  128.    End
  129.    Begin VB.Label Label3 
  130.       Caption         =   "Subject:"
  131.       Height          =   255
  132.       Left            =   120
  133.       TabIndex        =   6
  134.       Top             =   1200
  135.       Width           =   1215
  136.    End
  137.    Begin VB.Label Label2 
  138.       Caption         =   "To: (Their E-Mail Address)"
  139.       Height          =   252
  140.       Left            =   120
  141.       TabIndex        =   4
  142.       Top             =   600
  143.       Width           =   2292
  144.    End
  145.    Begin VB.Label Label1 
  146.       Caption         =   "From: (Your E-Mail Address)"
  147.       Height          =   252
  148.       Left            =   120
  149.       TabIndex        =   2
  150.       Top             =   0
  151.       Width           =   2052
  152.    End
  153. Attribute VB_Name = "frmMain"
  154. Attribute VB_GlobalNameSpace = False
  155. Attribute VB_Creatable = False
  156. Attribute VB_PredeclaredId = True
  157. Attribute VB_Exposed = False
  158. Dim Response As String, Reply As Integer, DateNow As String
  159. Dim first As String, Second As String, Third As String
  160. Dim Fourth As String, Fifth As String, Sixth As String
  161. Dim Seventh As String, Eighth As String
  162. Dim Start As Single, Tmr As Single
  163. Sub SendEmail(MailServerName As String, FromName As String, FromEmailAddress As String, ToName As String, ToEmailAddress As String, EmailSubject As String, EmailBodyOfMessage As String)
  164.           
  165.     Winsock1.LocalPort = 0 ' Must set local port to 0 (Zero) or you can only send 1 e-mail pre program start
  166. If Winsock1.State = sckClosed Then ' Check to see if socket is closed
  167.     DateNow = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & " -0600"
  168.     first = "mail from:" + Chr(32) + FromEmailAddress + vbCrLf ' Get who's sending E-Mail address
  169.     Second = "rcpt to:" + Chr(32) + ToEmailAddress + vbCrLf ' Get who mail is going to
  170.     Third = "Date:" + Chr(32) + DateNow + vbCrLf ' Date when being sent
  171.     Fourth = "From:" + Chr(32) + FromName + vbCrLf ' Who's Sending
  172.     Fifth = "To:" + Chr(32) + ToNametxt + vbCrLf ' Who it going to
  173.     Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf ' Subject of E-Mail
  174.     Seventh = EmailBodyOfMessage + vbCrLf ' E-mail message body
  175.     Ninth = "WebNet Browser: WebNet Browser E-Mail Program" + vbCrLf ' What program sent the e-mail, customize this
  176.     Eighth = Fourth + Third + Ninth + Fifth + Sixth  ' Combine for proper SMTP sending
  177.     Winsock1.Protocol = sckTCPProtocol ' Set protocol for sending
  178.     Winsock1.RemoteHost = MailServerName ' Set the server address
  179.     Winsock1.RemotePort = 25 ' Set the SMTP Port
  180.     Winsock1.Connect ' Start connection
  181.     WaitFor ("220")
  182.     StatusTxt.Caption = "Connecting...."
  183.     StatusTxt.Refresh
  184.     Winsock1.SendData ("HELO worldcomputers.com" + vbCrLf)
  185.     WaitFor ("250")
  186.     StatusTxt.Caption = "Connected"
  187.     StatusTxt.Refresh
  188.     Winsock1.SendData (first)
  189.     StatusTxt.Caption = "Sending Message"
  190.     StatusTxt.Refresh
  191.     WaitFor ("250")
  192.     Winsock1.SendData (Second)
  193.     WaitFor ("250")
  194.     Winsock1.SendData ("data" + vbCrLf)
  195.     WaitFor ("354")
  196.     Winsock1.SendData (Eighth + vbCrLf)
  197.     Winsock1.SendData (Seventh + vbCrLf)
  198.     Winsock1.SendData ("." + vbCrLf)
  199.     WaitFor ("250")
  200.     Winsock1.SendData ("quit" + vbCrLf)
  201.     StatusTxt.Caption = "Disconnecting"
  202.     StatusTxt.Refresh
  203.     WaitFor ("221")
  204.     Winsock1.Close
  205.     MsgBox (Str(Winsock1.State))
  206. End If
  207. End Sub
  208. Sub WaitFor(ResponseCode As String)
  209.     Start = Timer ' Time event so won't get stuck in loop
  210.     While Len(Response) = 0
  211.         Tmr = Start - Timer
  212.         DoEvents ' Let System keep checking for incoming response **IMPORTANT**
  213.         If Tmr > 50 Then ' Time in seconds to wait
  214.             MsgBox "SMTP service error, timed out while waiting for response", 64, MsgTitle
  215.             Exit Sub
  216.         End If
  217.     Wend
  218.     While Left(Response, 3) <> ResponseCode
  219.         DoEvents
  220.         If Tmr > 50 Then
  221.             MsgBox "SMTP service error, impromper response code. Code should have been: " + ResponseCode + " Code recieved: " + Response, 64, MsgTitle
  222.             Exit Sub
  223.         End If
  224.     Wend
  225. Response = "" ' Sent response code to blank **IMPORTANT**
  226. End Sub
  227. Private Sub Command1_Click()
  228.     SendEmail txtEmailServer.Text, txtFromName.Text, txtFromEmailAddress.Text, txtToEmailAddress.Text, txtToEmailAddress.Text, txtEmailSubject.Text, txtEmailBodyOfMessage.Text
  229.     'MsgBox ("Mail Sent")
  230.     StatusTxt.Caption = "Mail Sent"
  231.     StatusTxt.Refresh
  232.     Beep
  233.     Close
  234. End Sub
  235. Private Sub Command2_Click()
  236. Unload Me
  237. End Sub
  238. Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
  239.     Winsock1.GetData Response ' Check for incoming response *IMPORTANT*
  240. End Sub
  241.